home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Network PC
/
Network PC.iso
/
windows 95 utilities
/
programming tools
/
extended pagecontrol
/
extpage.int
< prev
next >
Wrap
Text File
|
1997-04-19
|
14KB
|
412 lines
Unit ExtPage;
//-------------------------------------------------------------//
// //
// Components Extended PageControl & Extended TabControl //
// //
// Date: April, 20 1997 //
// Version: 2.2 //
// Author: Jan - M. Strube //
// System: Delphi 2.01 / Delphi 3 / Borland C++Builder //
// //
// http://ourworld.compuserve.com/homepages/praxisservice/ //
// //
//-------------------------------------------------------------//
{$DEFINE NODEBUG} // DEBUG / NODEBUG
{$ALIGN ON}
{$BOOLEVAL OFF}
{$EXTENDEDSYNTAX ON}
{$HINTS ON}
{$LONGSTRINGS ON}
{$OPTIMIZATION ON}
{$SAFEDIVIDE OFF}
{$STACKFRAMES OFF}
{$TYPEDADDRESS ON}
{$VARSTRINGCHECKS OFF}
{$WARNINGS ON}
{$WRITEABLECONST OFF}
{$IFDEF DEBUG}
{$DEBUGINFO ON}
{$LOCALSYMBOLS ON}
{$OVERFLOWCHECKS ON}
{$RANGECHECKS ON}
{$REFERENCEINFO ON}
{$STACKCHECKS ON}
{$ELSE}
{$DEBUGINFO OFF}
{$LOCALSYMBOLS OFF}
{$OVERFLOWCHECKS OFF}
{$RANGECHECKS OFF}
{$REFERENCEINFO OFF}
{$STACKCHECKS OFF}
{$ENDIF}
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls,
StdCtrls, ComCtrls, CommCtrl;
const
TCS_BOTTOM = $0002;
TCS_RIGHT = $0002;
TCS_VERTICAL = $0080;
type
TExtGlyphPosition = (glPosLeft, glPosTop);
TExtGlyphs = class(TPersistent)
private
FGlyph: TBitmap;
FGlyphPaint: TBitmap;
FGlpyhOwner: TControl;
FImageList: TImageList;
FNumGlyphs: Word;
FOnChange: TNotifyEvent;
FOnChangeGlyph: TNotifyEvent;
FPosition: TExtGlyphPosition;
FSpacing: Integer;
FTransparentColor: TColor;
procedure SetGlyph(Value: TBitmap);
procedure SetNumGlyphs(Value: Word);
procedure SetPosition(Value: TExtGlyphPosition);
procedure SetSpacing(Value: Integer);
procedure SetTransparentColor(Value: TColor);
protected
procedure Changed(Sender: TObject);
procedure ChangedGlyph(Sender: TObject);
public
constructor Create(AOwner: TControl);
destructor Destroy; override;
property ImageList: TImageList
read FImageList;
property OnChange: TNotifyEvent
read FOnChange
write FOnChange;
property OnChangeGlyph: TNotifyEvent
read FOnChangeGlyph
write FOnChangeGlyph;
published
property Glyph: TBitmap
read FGlyph
write SetGlyph;
property NumGlyphs: Word
read FNumGlyphs
write SetNumGlyphs
default 0;
property Position: TExtGlyphPosition
read FPosition
write SetPosition
default glPosLeft;
property Spacing: Integer
read FSpacing
write SetSpacing
default 5;
property TransparentColor: TColor
read FTransparentColor
write SetTransparentColor
default clFuchsia;
end;
EExtPageInvalidCall = class(Exception);
TExtNbDrawTabEvent = procedure(Control: TWinControl; Index: Integer;
ActiveTab: Boolean; const RectFg, RectBg: TRect;
State: TOwnerDrawState) of object;
TExtTabStyle = (tabStDefault, tabStButton);
TExtTabPosition = (tabPosLeft, tabPosRight, tabPosTop, tabPosBottom);
TExtPageControl = class(TPageControl)
private
FCanvas: TCanvas;
FHintOrg: String;
FirstPaint: Boolean;
FLastTabHintIndex: Integer;
FOnDrawTab: TExtNbDrawTabEvent;
FTabActiveColor: TColor;
FTabActiveFont: TFont;
FTabGlyphs: TExtGlyphs;
FTabHeight: Word;
FTabHints: TStringList;
FTabInactiveColor: TColor;
FTabInactiveFont: TFont;
FTabPosition: TExtTabPosition;
FTabStyle: TExtTabStyle;
FTabWidth: Word;
FTabWordWrap: Boolean;
StopBGPainting: Boolean;
StopBGPaintingTabs: Boolean;
StopFGPaintingTabs: Boolean;
procedure CheckAndSetHWndFont;
function GetActivePage: TTabSheet;
procedure SetActivePage(Value: TTabSheet);
procedure SetTabActiveColor(Value: TColor);
procedure SetTabActiveFont(Value: TFont);
procedure SetTabGlyphs(Value: TExtGlyphs);
procedure SetTabHeight(Value: Word);
procedure SetTabHints(Value: TStringList);
procedure SetTabInactiveColor(Value: TColor);
procedure SetTabInactiveFont(Value: TFont);
procedure SetTabPosition(Value: TExtTabPosition);
procedure SetTabStyle(Value: TExtTabStyle);
procedure SetTabWidth(Value: Word);
procedure SetTabWordWrap(Value: Boolean);
procedure CMDialogChar(var Msg: TCMDialogChar); message CM_DIALOGCHAR;
procedure CMFontChanged(var Msg: TMessage); message CM_FONTCHANGED;
procedure CMHintShow(var Msg: TMessage); message CM_HINTSHOW;
procedure CMParentColorChanged(var Msg: TMessage); message CM_PARENTCOLORCHANGED;
procedure CNDrawTab(var Msg: TWMDrawItem); message CN_DRAWITEM;
procedure TCMInsertItem(var Msg: TMessage); message TCM_INSERTITEM;
procedure WMEraseBkgnd(var Msg: TWMEraseBkgnd); message WM_ERASEBKGND;
procedure WMLButtonDown(var Msg: TWMLButtonDown); message WM_LBUTTONDOWN;
procedure WMPaint(var Msg: TWMPaint); message WM_PAINT;
procedure WMSetCursor(var Msg: TWMSetCursor); message WM_SETCURSOR;
protected
procedure ChangeScale(M, D: Integer); override;
procedure CreateParams(var Params: TCreateParams); override;
procedure CreateWnd; override;
procedure FillTabBG(DC: HDC; ActiveTab: Boolean; const TabRect: TRect); virtual;
function GetTabNumber(CurrentPos: TPoint): Integer; virtual;
procedure GlyphHasChanged(Sender: TObject);
procedure GlyphHasChangedPicture(Sender: TObject);
procedure Loaded; override;
procedure ReAlignTabSheets; virtual;
procedure TabFontChanged(Sender: TObject); virtual;
function TabTextOut(Rect: TRect; Margin: TPoint; Text: String;
Align: TAlignment; Disabled: Boolean): TPoint; virtual;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure BeginUpdate; virtual;
procedure DefaultDrawTab(Index: Integer; const RectFg: TRect;
State: TOwnerDrawState); virtual;
procedure DestroyAllOtherSheetHandles; virtual;
procedure DrawTab(Index: Integer; ActiveTab: Boolean;
const RectFg, RectBg: TRect; State: TOwnerDrawState); virtual;
procedure EndUpdate; virtual;
function GetPageIndexByTabIndex(CurrentTabIndex: Integer): Integer;
procedure GetSheetRect(var SheetRect: TRect); virtual;
function IsNewComCtl: Boolean;
property Canvas: TCanvas read FCanvas;
published
property ActivePage: TTabSheet
read GetActivePage
write SetActivePage;
property Color;
property ParentColor;
property TabActiveColor: TColor
read FTabActiveColor
write SetTabActiveColor;
property TabActiveFont: TFont
read FTabActiveFont
write SetTabActiveFont;
property TabGlyphs: TExtGlyphs
read FTabGlyphs
write SetTabGlyphs;
property TabHeight: Word
read FTabHeight
write SetTabHeight;
property TabHints: TStringList
read FTabHints
write SetTabHints;
property TabInactiveColor: TColor
read FTabInactiveColor
write SetTabInactiveColor;
property TabInactiveFont: TFont
read FTabInactiveFont
write SetTabInactiveFont;
property TabPosition: TExtTabPosition
read FTabPosition
write SetTabPosition
default tabPosTop;
property TabStyle: TExtTabStyle
read FTabStyle
write SetTabStyle
default tabStDefault;
property TabWidth: Word
read FTabWidth
write SetTabWidth;
property TabWordWrap: Boolean
read FTabWordWrap
write SetTabWordWrap
default False;
property OnDrawTab: TExtNbDrawTabEvent
read FOnDrawTab
write FOnDrawTab;
end;
TExtTabControl = class(TTabControl)
private
FCanvas: TCanvas;
FHintOrg: String;
FirstPaint: Boolean;
FLastTabHintIndex: Integer;
FOnDrawTab: TExtNbDrawTabEvent;
FTabActiveColor: TColor;
FTabActiveFont: TFont;
FTabDisabledList: TList;
FTabGlyphs: TExtGlyphs;
FTabHeight: Word;
FTabHints: TStringList;
FTabInactiveColor: TColor;
FTabInactiveFont: TFont;
FTabPosition: TExtTabPosition;
FTabStyle: TExtTabStyle;
FTabWidth: Word;
FTabWordWrap: Boolean;
StopBGPainting: Boolean;
StopBGPaintingTabs: Boolean;
StopFGPaintingTabs: Boolean;
procedure CheckAndSetHWndFont;
function GetTabEnabled(Index: Integer): Boolean;
function GetTabIndex: Integer;
procedure SetTabActiveColor(Value: TColor);
procedure SetTabActiveFont(Value: TFont);
procedure SetTabEnabled(Index: Integer; Value: Boolean);
procedure SetTabGlyphs(Value: TExtGlyphs);
procedure SetTabHeight(Value: Word);
procedure SetTabHints(Value: TStringList);
procedure SetTabInactiveColor(Value: TColor);
procedure SetTabInactiveFont(Value: TFont);
procedure SetTabIndex(Value: Integer);
procedure SetTabPosition(Value: TExtTabPosition);
procedure SetTabStyle(Value: TExtTabStyle);
procedure SetTabWidth(Value: Word);
procedure SetTabWordWrap(Value: Boolean);
procedure CMDialogChar(var Msg: TCMDialogChar); message CM_DIALOGCHAR;
procedure CMFontChanged(var Msg: TMessage); message CM_FONTCHANGED;
procedure CMHintShow(var Msg: TMessage); message CM_HINTSHOW;
procedure CMParentColorChanged(var Msg: TMessage); message CM_PARENTCOLORCHANGED;
procedure CNDrawTab(var Msg: TWMDrawItem); message CN_DRAWITEM;
procedure TCMInsertItem(var Msg: TMessage); message TCM_INSERTITEM;
procedure WMEraseBkgnd(var Msg: TWMEraseBkgnd); message WM_ERASEBKGND;
procedure WMLButtonDown(var Msg: TWMLButtonDown); message WM_LBUTTONDOWN;
procedure WMPaint(var Msg: TWMPaint); message WM_PAINT;
procedure WMSetCursor(var Msg: TWMSetCursor); message WM_SETCURSOR;
protected
procedure ChangeScale(M, D: Integer); override;
procedure CreateParams(var Params: TCreateParams); override;
procedure CreateWnd; override;
procedure FillTabBG(DC: HDC; ActiveTab: Boolean; const TabRect: TRect); virtual;
function GetTabNumber(CurrentPos: TPoint): Integer; virtual;
procedure GlyphHasChanged(Sender: TObject);
procedure GlyphHasChangedPicture(Sender: TObject);
procedure Loaded; override;
procedure TabFontChanged(Sender: TObject); virtual;
function TabTextOut(Rect: TRect; Margin: TPoint; Text: String;
Align: TAlignment; Disabled: Boolean): TPoint; virtual;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure BeginUpdate; virtual;
procedure DefaultDrawTab(Index: Integer; const RectFg: TRect;
State: TOwnerDrawState); virtual;
procedure DrawTab(Index: Integer; ActiveTab: Boolean;
const RectFg, RectBg: TRect; State: TOwnerDrawState); virtual;
procedure EndUpdate; virtual;
procedure GetSheetRect(var SheetRect: TRect); virtual;
function IsNewComCtl: Boolean;
property Canvas: TCanvas
read FCanvas;
property TabEnabled[Index: Integer]: Boolean
read GetTabEnabled
write SetTabEnabled;
published
property Color;
property ParentColor;
property TabActiveColor: TColor
read FTabActiveColor
write SetTabActiveColor;
property TabActiveFont: TFont
read FTabActiveFont
write SetTabActiveFont;
property TabGlyphs: TExtGlyphs
read FTabGlyphs
write SetTabGlyphs;
property TabHeight: Word
read FTabHeight
write SetTabHeight;
property TabHints: TStringList
read FTabHints
write SetTabHints;
property TabInactiveColor: TColor
read FTabInactiveColor
write SetTabInactiveColor;
property TabInactiveFont: TFont
read FTabInactiveFont
write SetTabInactiveFont;
property TabIndex: Integer
read GetTabIndex
write SetTabIndex;
property TabPosition: TExtTabPosition
read FTabPosition
write SetTabPosition
default tabPosTop;
property TabStyle: TExtTabStyle
read FTabStyle
write SetTabStyle
default tabStDefault;
property TabWidth: Word
read FTabWidth
write SetTabWidth;
property TabWordWrap: Boolean
read FTabWordWrap
write SetTabWordWrap
default False;
property OnDrawTab: TExtNbDrawTabEvent
read FOnDrawTab
write FOnDrawTab;
end;
procedure Register;
implementation
...
procedure Register;
begin
RegisterComponents('Win95', [TExtPageControl]);
RegisterComponents('Win95', [TExtTabControl]);
end;
end.